'=============================================================================== '= Copyright 1992 Staz™ Software, Inc. = '= All rights reserved / "PG PRO.INCL" from PG:PRO II = '=============================================================================== INCLUDE FILE _aplIncl COMPILE 0,_MacsbugLabels_strResource_caseInsensitive'set by PG:PRO GLOBALS "PG PRO.GLBL"'include standard global file END GLOBALS'no other globals DEFSTR LONG GOTO "PG:Start" '_______________________________________________________________________________ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ ALERTS/DIALOGS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '——————————————————————————————————————————————————————————————————————————————— '_______________________________________________________________________________ LOCAL FN pGcntrRes(type&,resID)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM t,l,b,r'local rect CURSOR _arrowCursor'reset arrow cursor hndl& = FN GETRESOURCE(type&,resID)'handle to alert resource LONG IF hndl&'got a handle? t;8 = [hndl&]'copy alert's rect CALL OFFSETRECT(t,-l,-t)'center it CALL OFFSETRECT(t,gScrnR/2-r/2,{_mBarHeight}+gScrnB/3-b/3) BLOCKMOVE @t,[hndl&],8'modify the resource END IF END FN '_______________________________________________________________________________ LOCAL FN pGshowErr(errorNum)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM pTxt$(3)'holds message strings '## Description ---------- ## Description ---------- ## Description ---------- '01 Add/Chg res failed 05 couldn't save pG3c res 09 used pGbuild(0) '02 couldn't get pG3w res 06 name of PG PRO app 10 used pGclose(0) '03 couldn't save pG3w res 07 paste too big for fld 11 your codes start here '04 couldn't get pG3c res 08 too many chars in fld 00 You CALL PARAMTEXT! '## Description ---------- ## Description ---------- ## Description ---------- FN pGcntrRes(_"ALRT",_baseID-1)'center the error alert window LONG IF errorNum pTxt$(1) = STR#(_baseID-1,errorNum)'error message from STR# pTxt$(2) = MID$(STR$(errorNum),2)'error number from entry param pTxt$(3) = STR#(_baseID-1,6)'error message from STR# CALL PARAMTEXT(pTxt$(1),pTxt$(2),pTxt$(3),"")'set up text for alert END IF x = FN ALERT(_baseID-1,0)'show the alert END FN '_______________________________________________________________________________ LOCAL FN pGgetText$(theDialog&,theItem)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM t;8'local DIMs CALL GETDITEM(theDialog&,theItem,itemType,itemHandle&,t) CALL GETITEXT(itemHandle&,theText$)'get the text END FN = theText$'return simple string '_______________________________________________________________________________ LOCAL FN pGsetText(theDialog&,theItem,theText$)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM t;8'local DIMs/get this item CALL GETDITEM(theDialog&,theItem,itemType,itemHandle&,t) CALL SETITEXT(itemHandle&,theText$)'get the text CALL SELITEXT(theDialog&,theItem,0,[itemHandle&]+_TELength) END FN '_______________________________________________________________________________ LOCAL FN pGframeBtn(theDialog&,theItem)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— CALL SETPORT(theDialog&)'allow drwg before MODALDIALOG DIM t;8'local DIMs/get this item CALL GETDITEM(theDialog&,theItem,itemType,itemHandle&,t) CALL INSETRECT(t,-4,-4)'expand rect CALL PENNORMAL:PEN 3,3'3x3 pen LONG IF PEEK([itemHandle&]+_contrlHilite)=255'btn disabled CALL PENPAT(#REGISTER(A5)-28)'make it gray END IF' CALL FRAMEROUNDRECT(t,16,16)'frame it CALL PENNORMAL'restore pen END FN '_______________________________________________________________________________ LOCAL FN pGask$(theQuestion$,theAnswer$)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— theWindow = WINDOW(_activeWnd)'record current window CALL GETPORT(oldPort&) FN pGcntrRes(_"DLOG",_baseID - 2)'center the dialog CALL PARAMTEXT(theQuestion$,"","","")'show the prompt theDialog& = FN GETNEWDIALOG(_baseID - 2,0,-1)'get & disp the resource FN pGsetText(theDialog&,3,theAnswer$):theAnswer$=""'default answer FN pGframeBtn(theDialog&,1)'frame the OK btn DO'here we go CALL MODALDIALOG(0,hitItem)'cycle till OK/Cancel clicked UNTIL hitItem < 3' LONG IF hitItem = 1'was it OK? theAnswer$ = FN pGgetText$(theDialog&,3)'yes, return the answer IF theAnswer$="" THEN theAnswer$=" "'send a space if OK'd null END IF CALL DISPOSDIALOG(theDialog&)'all done LONG IF theWindow WINDOW(theWindow)'restore active window XELSE IF oldPort& THEN CALL SETPORT(oldPort&) END IF END FN = theAnswer$ '_______________________________________________________________________________ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ RESOURCE FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '——————————————————————————————————————————————————————————————————————————————— '_______________________________________________________________________________ LOCAL FN pGreplaceRes(resHndl&,resTp&,resID,resName$)'∑∑œœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— LONG IF resHndl& hndlFlags = FN HGETSTATE(resHndl&)'get state of new handle LONG IF hndlFlags AND _resource%'!! tried to send res hndl!! OSErr = FN HNOPURGE(resHndl&)'don't allow purge during copy newHndl& = FN HANDTOHAND(resHndl&)'duplicate the handle OSErr = FN HSETSTATE(resHndl&,hndlFlags)'restore orig state resHndl& = newHndl&'now use the new hndl END IF END IF LONG IF resHndl& curRes = FN CURRESFILE'record current res reference CALL USERESFILE(gResRef)'use output file oldRes& = FN GET1RESOURCE(resTp&,resID)'check for existing res LONG IF oldRes&'got one? hndlFlags = FN HGETSTATE(oldRes&)'save current handle info OSErr = FN HUNLOCK(oldRes&)'unlock it OSErr = FN HNOPURGE(oldRes&)'don't allow purge theSize& = FN GETHANDLESIZE(resHndl&)'get new size OSErr = FN SETHANDLESIZE(oldRes&,theSize&)'resize old to match BLOCKMOVE [resHndl&],[oldRes&],theSize&'replace old data OSErr = FN HSETSTATE(oldRes&,hndlFlags)'restore handle info oldRes& = FN STRIPADDRESS(oldRes&)'fix toolbox error CALL CHANGEDRESOURCE(oldRes&)'mark it as changed OSErr = FN DISPOSHANDLE(resHndl&)'dump the duplicate hndl LONG IF LEN(resName$) CALL SETRESINFO(oldRes&,resID,resName$) END IF XELSE'otherwise, just add it OSErr = FN HPURGE(resHndl&)'make it purgable now CALL ADDRESOURCE(resHndl&,resTp&,resID,resName$)'add it CALL SETRESATTRS(resHndl&,_resPurgeable%)'make it purgable resHndl& = FN STRIPADDRESS(resHndl&)'fix toolbox error CALL CHANGEDRESOURCE(resHndl&)'mark change(after SETRESATTRS) END IF' CALL USERESFILE(curRes)'restore orig file LONG IF FN RESERROR OR OSErr'any problems? FN pGshowErr(1)'my error code for failure END IF END IF END FN '_______________________________________________________________________________ LOCAL FN pGreplaceXRes(resHndl&,resTp&,resID,resName$,resRef)'∑∑œœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— oldRes = gResRef'record old res file ref gResRef = resRef'temp switch to new FN pGreplaceRes(resHndl&,resTp&,resID,resName$)'save res in new file gResRef = oldRes'switch back to orig file END FN '_______________________________________________________________________________ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ OBJECT FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '——————————————————————————————————————————————————————————————————————————————— '_______________________________________________________________________________ LOCAL FN pGcountObj(objListID)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— resHndl& = FN GETRESOURCE(_"pG3c",objListID)'handle to wnd cntrl resource LONG IF resHndl&'valid handle? objCount = {[resHndl&]}'obj count is first word of res XELSE'no handle? FN pGshowErr(4)'tell user something's wrong objCount = 0'send back zero count END IF' END FN = objCount'FN result is num of elements '_______________________________________________________________________________ LOCAL FN pGgetObj(objListID,objElem)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— resHndl& = FN GETRESOURCE(_"pG3c",objListID)'handle to wnd cntrl resource LONG IF resHndl&'valid handle? DEC(objElem)'allow for OCNT offSet& = 2 + objElem * _objRecSz'calc offset to correct element gObject = [resHndl&]+offSet&'blkmove to global record XELSE'no handle? FN pGshowErr(4)'tell user something's wrong END IF' END FN '_______________________________________________________________________________ LOCAL FN pGputObj(objListID,objElem)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— resHndl& = FN GETRESOURCE(_"pG3c",objListID)'handle to wnd cntrl resource LONG IF resHndl&'valid handle? hState = FN HGETSTATE(resHndl&) OSErr = FN HNOPURGE(resHndl&) DEC(objElem)'allow for OCNT offSet& = 2 + objElem * _objRecSz'calc offset to correct element BLOCKMOVE @gObjSel,[resHndl&]+offSet&,_objRecSz'blkmove to resource resHndl& = FN STRIPADDRESS(resHndl&)'fix toolbox error CALL CHANGEDRESOURCE(resHndl&)'mark it as changed OSErr = FN HSETSTATE(resHndl&,hState) XELSE'no handle? FN pGshowErr(5)'tell user something's wrong END IF END FN '_______________________________________________________________________________ LOCAL FN pGgetRef(objListID,theRef)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— theCount = FN pGcountObj(objListID)'number of objects element = 0'element not yet found LONG IF theCount'non-zero count? FOR loop = 1 TO theCount'loop thru object list FN pGgetObj(objListID,loop)'get this object LONG IF gObjKind <> _graphicObj'ref not valid on graphics LONG IF ABS(gObjRef) = ABS(theRef)'matches reference? element = loop'record element loop = theCount'shortcut the loop END IF' END IF NEXT END IF' END FN = element'global record filled on return '_______________________________________________________________________________ LOCAL FN pGpointInObj'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM t;8 theObject = 0 objCount = FN pGcountObj(gWhichClass)'get num of objs in list LONG IF objCount'non zero? resHndl& = FN GETRESOURCE(_"pG3c",gWhichClass) FOR loop = objCount-1 TO 0 STEP - 1'loop thru backwards offSet& = 2 + loop * _objRecSz t;8 = [resHndl&] + offSet& + 6 LONG IF FN PTINRECT(gMouseY,t)'clicked here? theObject = loop + 1'set return value to this obj loop = 0'jump the loop END IF NEXT END IF END FN = theObject '_______________________________________________________________________________ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ DRAWING FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '——————————————————————————————————————————————————————————————————————————————— '_______________________________________________________________________________ LOCAL FN pGdepthOfPoint(my,mx)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— inColor = _false LONG IF SYSTEM(_macPlus) = _false CALL LOCALTOGLOBAL(my) gdHndl& = FN GETDEVICELIST WHILE gdHndl& LONG IF FN PTINRECT(my,#[gdHndl&]+_gdRect) IF {[[[gdHndl&]+_gdpMap]]+_pmPixelSize} > 2 THEN inColor = _zTrue gdHndl& = 0 END IF IF gdHndl& THEN gdHndl& = FN GETNEXTDEVICE(gdHndl&) WEND END IF END FN = inColor '_______________________________________________________________________________ CLEAR LOCAL LOCAL FN pGblackAndWhite'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM RECORD aWndRec'auxiliary window rec DIM setCPat ,aWndCPatID DIM setBWPat ,aWndBWPatID DIM setRGB ,aWndRGBrec;6 DIM aWndType&,aWndRefCon& DIM setFont ,aWndFSize,aWndFMode,aWndFFace DIM setSpare ,aWndData;40,aWndDCODID DIM aWndRsrv1&,aWndRsrv2& DIM 60 aWndFontName$ DIM END RECORD _aWndSz CALL PENNORMAL'fix pen CALL FORECOLOR(33) CALL BACKCOLOR(30) resHndl& = FN GETRESOURCE(_"pG3*",gWhichClass) LONG IF resHndl& BLOCKMOVE [resHndl&],@aWndRec,_aWndSz inColor = FN pGdepthOfPoint(WINDOW(3)/2,WINDOW(2)/2) LONG IF inColor'not black & white? LONG IF setCPat ppat& = FN GETPIXPAT(aWndCPatID) LONG IF ppat& CALL BACKPIXPAT(ppat&) END IF END IF LONG IF setRGB CALL RGBBACKCOLOR(aWndRGBrec) END IF XELSE'black & white LONG IF setBWPat pat& = FN GETPATTERN(aWndBWPatID) ` BEQ.S noPat ` MOVE.L D0,A0 ` MOVE.L (A0),-(SP) ` _backPat `noPat END IF END IF LONG IF setFont'default font LONG IF WINDOW(_outputWnd) CALL GETFNUM(aWndFontName$,fNum) TEXT fNum,aWndFSize,aWndFFace,aWndFMode-1 END IF END IF END IF END FN '_______________________________________________________________________________ LOCAL FN pGuseObjColor'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— LONG IF gScreenDepth > 1'not black & white? CALL RGBFORECOLOR(gObjFRed)'use object's forecolor CALL RGBBACKCOLOR(gObjBRed)'use object's backcolor END IF END FN '_______________________________________________________________________________ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ CONTROL FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '——————————————————————————————————————————————————————————————————————————————— '_______________________________________________________________________________ LOCAL FN pGfixEditor'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM t,l,b,r LONG IF WINDOW(_EFnum) = 8001'is this a Text Editor? FN pGgetRef(WINDOW(_outputWClass),8001) LONG IF gObjAutoReSz t;8 = WINDOW(_wndPointer)+_portRect'get window's rect r=r-15:b=b-17'inset for scroll bars LONG IF BUTTON&(8000) wd = {[PRHANDLE] + _prInfo + _rPage + _right} SCROLL BUTTON 8000,,,wd,wd/5 TEHndl& = TEHANDLE(8001) LONG IF TEHndl& BLOCKMOVE @t,[TEHndl&]+8,8 oldR = r r = l + wd + 34 CALL OFFSETRECT(t,-BUTTON(8000)+_TEWndInset,0) BLOCKMOVE @t,[TEHndl&],8 r = oldR CALL TECALTEXT(TEHndl&) CALL TEUPDATE(t,TEHndl&) END IF XELSE CALL INSETRECT(t,_TEWndInset,_TEWndInset) EDIT FIELD 8001,,@t END IF LONG IF BUTTON&(8001)'vert scroll present? rowCnt = ((b-t) >> 4) - 2'calc an avg row count SCROLL BUTTON 8001,,,,rowCnt'reset pg up/down END IF END IF END IF END FN '_______________________________________________________________________________ LOCAL FN pGdrawControls'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— theCount = FN pGcountObj(gWhichClass)'count objects in window cBackPat = FN pGblackAndWhite firstFld = 0 LONG IF theCount'non-zero? ' FOR loop = 1 TO theCount'fields before scroll bars FN pGgetObj(gWhichClass,loop)'get next object LONG IF gObjKind = _pictObj'it's a pict field LONG IF gObjResID'picture included? PICTURE FIELD gObjRef,%gObjResID,@gObjT,gObjZType,gObjZJust XELSE'no picture PICTURE FIELD gObjRef,"",@gObjT,gObjZType,gObjZJust END IF END IF'end of pict obj LONG IF gObjKind = _styleObj'styled text field? gObjZJust = gObjZJust + (gObjFRed<<2) LONG IF gObjResID'existing text? resHndl& = FN GETRESOURCE(_"pG3t",gObjResID) LONG IF resHndl& EDIT FIELD -gObjRef,&resHndl&,(gObjL,gObjT)-(gObjR,gObjB),gObjZType,gObjZJust END IF XELSE'build it blank EDIT FIELD -gObjRef,"",@gObjT,gObjZType,gObjZJust END IF'NOTE: fields built 1st to allow LONG IF firstFld = 0 LONG IF ((gObjZType-1) AND &X1100)=0'not a static or gray field LONG IF gObjRef < 8000 firstFld = gObjRef END IF END IF END IF'attachment to scroll bars LONG IF firstFld = 0 LONG IF ((gObjZType-1) AND &X1100)=0'not a static or gray field LONG IF gObjRef < 8000 firstFld = gObjRef END IF END IF END IF END IF'end of _styleObj NEXT ' FOR loop = 1 TO theCount'scroll bars before lists FN pGgetObj(gWhichClass,loop)'get next object LONG IF gObjKind = _scrollObj'scroll bar? LONG IF ABS(gObjSel) <>1'part of a group? group = gObjSel'record current group attachedRef = 0 FOR stylLoop = 1 TO theCount'loop thru obj list LONG IF stylLoop <> loop'not the same object FN pGgetObj(gWhichClass,stylLoop)'get obj record LONG IF group = gObjSel'part of same group? LONG IF gObjKind = _styleObj'styled field? attachedRef = -gObjRef'attach button to style field stylLoop = theCount'short cut rest of the loop END IF END IF END IF NEXT FN pGgetObj(gWhichClass,loop)'reload old record LONG IF attachedRef'was there a matching field? gObjRef = attachedRef'yes, change this reference END IF END IF SCROLL BUTTON gObjRef,gObjCtrlVal,gObjMin,gObjMax,gObjPgUpDn,@gObjT,gObjZType END IF'attachment to scroll bars NEXT ' FOR loop = 1 TO theCount'loop thru list FN pGgetObj(gWhichClass,loop)'get next object SELECT gObjKind'what kind is it? CASE _styleObj,_pictObj'fields already built CASE _scrollObj'scroll bars already built CASE _buttonObj'it's a button LONG IF gObjZType objText$ = STR#(_baseID,gObjElement) BUTTON gObjRef,gObjCtrlVal,objText$,@gObjT,gObjZType XELSE gSubAction = _otherUserInit'set flag to init obj gWhichObjElem = loop oldWClass = gWhichClass GLOBALS GOSUB "PG:Any Other" gWhichClass = oldWClass FN pGblackAndWhite'user may have chgd bkgnd END IF CASE _listObj'it's a scrolling list resHndl& = FN GETRESOURCE(_"STR#",gObjResID) LONG IF resHndl& CALL GETRESINFO(resHndl&,ID,tp&,objText$) TEXT gObjLFont,gObjLSize,0,0 SWAP gObjFBlue,gObjBlue IF gScreenDepth > 1 THEN CALL RGBFORECOLOR(gObjFRed) SWAP gObjFBlue,gObjBlue BUTTON gObjRef,gObjResID,objText$,@gObjT,gObjZType END IF END SELECT NEXT'next object END IF LONG IF firstFld'got an active field EDIT FIELD firstFld'activate it SETSELECT 0,WINDOW(_EFTextLen)'select all its text END IF END FN '_______________________________________________________________________________ LOCAL FN pGsetGroup(theRef)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— selectedBtn = 0'default result = none element = FN pGgetRef(gWhichClass,theRef)'get the referenced element LONG IF element'got it? LONG IF gObjKind = _buttonObj'is it a button? LONG IF ABS(gObjSel) > 1'part of a group? LONG IF gObjZType = 3'a radio button? theGroup = gObjSel'this is the group we need theCount = FN pGcountObj(gWhichClass)'number of objects FOR loop = 1 TO theCount'loop thru list FN pGgetObj(gWhichClass,loop)'get this obj LONG IF gObjSel = theGroup'right group? LONG IF gObjKind = _buttonObj'is it a button? LONG IF gObjZType = 3'a radio button? LONG IF gObjRef = theRef'set this one? BUTTON gObjRef,2 XELSE LONG IF BUTTON(gObjRef) = 2'don't mess with disabled btns BUTTON gObjRef,1 END IF END IF END IF END IF END IF NEXT loop END IF END IF END IF END IF END FN '_______________________________________________________________________________ LOCAL FN pGgetGroup(theRef)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— selectedBtn = 0'default result = none element = FN pGgetRef(gWhichClass,theRef)'get the referenced element LONG IF element'got it? LONG IF gObjKind = _buttonObj'is it a button? LONG IF ABS(gObjSel) > 1'part of a group? LONG IF gObjZType = 3'a radio button? theGroup = gObjSel'this is the group we need theCount = FN pGcountObj(gWhichClass)'number of objects FOR loop = 1 TO theCount'loop thru list FN pGgetObj(gWhichClass,loop)'get this obj LONG IF gObjSel = theGroup'right group? LONG IF gObjKind = _buttonObj'is it a button? LONG IF gObjZType = 3'a radio button? LONG IF BUTTON(gObjRef) = 2'is it set? selectedBtn = gObjRef'gotcha loop = theCount'skip the rest of the loop END IF END IF END IF END IF NEXT loop END IF END IF END IF END IF END FN = selectedBtn '_______________________________________________________________________________ LOCAL FN pGbtnAction(theRef)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM t,l,b,r gDblClick = _false LONG IF theRef = 8000 FN pGfixEditor XELSE element = FN pGgetRef(gWhichClass,theRef)'get btn's obj record LONG IF element'found the record? SELECT gObjKind CASE _scrollObj'a scroll button? t;8 = @gObjT'record it's rect theGroup = gObjSel LONG IF ABS(theGroup)>1 theCount = FN pGcountObj(gWhichClass)'number of objects FOR loop = 1 TO theCount'loop thru list FN pGgetObj(gWhichClass,loop)'get this obj LONG IF gObjSel = theGroup LONG IF gObjKind = _listObj'scrolling list? LONG IF gObjT=t AND gObjR=l+1'next to this scroll bar? LONG IF BUTTON&(gObjRef) LONG IF {[[[BUTTON&(gObjRef)]+_contrlData]]} <> BUTTON(theRef)-1 %[[[BUTTON&(gObjRef)]+_contrlData]],BUTTON(theRef)-1 INC(gObjB):CALL CLIPRECT(gObjT)'add to clip & redraw CALL DRAW1CONTROL(BUTTON&(gObjRef)) BUTTON gObjRef,BUTTON(gObjRef)'restores autoclip END IF END IF loop = theCount'shortcut the loop END IF END IF END IF NEXT END IF CASE _buttonObj'regular button? SELECT gObjZType'what type? CASE 2'check box? LONG IF BUTTON(gObjRef) = 2'if it was selected BUTTON gObjRef,1'deselect it XELSE'otherwise BUTTON gObjRef,2'select it END IF CASE 3'radio button? LONG IF ABS(gObjSel) <> 1'should be part of a group theGroup = gObjSel'record group number theCount = FN pGcountObj(gWhichClass)'number of objects FOR loop = 1 TO theCount'loop thru list FN pGgetObj(gWhichClass,loop)'get this obj LONG IF gObjSel = theGroup'same group? LONG IF BUTTON(gObjRef)'only toggle active buttons LONG IF gObjRef = theRef'clicked button? BUTTON gObjRef,2'yes, select it XELSE'no BUTTON gObjRef,1'deselect it END IF END IF END IF NEXT END IF END SELECT CASE _listObj LONG IF FN TICKCOUNT <= gDblTime& LONG IF gDblRef = theRef LONG IF gDblWnd = gActiveWnd gDblClick = _zTrue END IF END IF END IF LONG IF gDblClick = _false IF _ignoreSnglClk THEN gAction = 0 gDblRef = theRef gDblTime& = FN TICKCOUNT + [_doubleTime] gDblWnd = gActiveWnd XELSE gDblWnd = 0 END IF END SELECT END IF END IF FN pGblackAndWhite END FN '_______________________________________________________________________________ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ WINDOW FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '——————————————————————————————————————————————————————————————————————————————— '_______________________________________________________________________________ LOCAL FN pGgetWnd$(resID,recordPtr&)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— resHndl& = FN GETRESOURCE(_"pG3w",resID) LONG IF resHndl& BLOCKMOVE [resHndl&],recordPtr&,FN GETHANDLESIZE(resHndl&) CALL GETRESINFO(resHndl&,resID,tp&,wTitle$) XELSE FN pGshowErr(2) wTitle$ = "ERROR" END IF END FN = wTitle$ '_______________________________________________________________________________ LOCAL FN pGputWnd(resID,recordPtr&)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— resHndl& = FN GETRESOURCE(_"pG3w",resID) LONG IF resHndl& OSErr = FN HNOPURGE(resHndl&) LONG IF FN GETHANDLESIZE(resHndl&) >0 BLOCKMOVE recordPtr&,[resHndl&],FN GETHANDLESIZE(resHndl&) resHndl& = FN STRIPADDRESS(resHndl&)'fix toolbox error CALL CHANGEDRESOURCE(resHndl&) END IF OSErr = FN HPURGE(resHndl&) XELSE FN pGshowErr(3) END IF END FN '_______________________________________________________________________________ LOCAL FN pGcalcWndGlobals'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— gActWindow = WINDOW(_activeWnd) gOutWindow = WINDOW(_outputWnd) gWhichClass = WINDOW(_outputWClass) END FN '_______________________________________________________________________________ LOCAL'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ DIM t;8 LOCAL FN pGinsetWnd(t;8,theWndType,rectPtr&)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— SELECT theWndType'what type of window is this? CASE 3,4 :CALL INSETRECT (t, 8, 8)'plain or shadow (8 pix border) CASE 2 :CALL INSETRECT (t,12,12)'modal dialog(8 pix gray+4 pix) CASE ELSE:CALL INSETRECT (t, 8, 8):t = t + 16'window with title bar END SELECT'done BLOCKMOVE @t,rectPtr&,8 END FN'return with rect's addr '_______________________________________________________________________________ LOCAL FN pGsetGrow'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM pGwT,pGwL,pGwB,pGwR,pGwKind,pGwAttrs,pGwMinX,pGwMinY DIM pGwMaxX,pGwMaxY,pGZmT,pGZmL,pGZmB,pGZmR DIM pGwHpg,pGwHMax,pGwVpg,pGwVMax,pGwRefCon& wTitle$ = FN pGgetWnd$(gWhichClass,@pGwT) IF pGwMinX < 50 THEN pGwMinX = 50 IF pGwMinY < 50 THEN pGwMinY = 50 IF pGwMaxX < pGwMinX THEN pGwMaxX = 1000 IF pGwMaxY < pGwMinY THEN pGwMaxY = 1000 MINWINDOW pGwMinX,pGwMinY MAXWINDOW pGwMaxX,pGwMaxY END FN '_______________________________________________________________________________ LOCAL FN pGsetZoom'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM t,l,b,r,centerY,centerX DIM pGwT,pGwL,pGwB,pGwR,pGwKind,pGwAttrs,pGwMinX,pGwMinY DIM pGwMaxX,pGwMaxY,pGZmT,pGZmL,pGZmB,pGZmR DIM pGwHpg,pGwHMax,pGwVpg,pGwVMax,pGwRefCon& wTitle$ = FN pGgetWnd$(gWhichClass,@pGwT) LONG IF [@pGZmB]'custom zoom size t;8 = @pGZmT XELSE t;8 = @gScrnT'just copy the main scrn centerY = WINDOW(_height)>>1 centerX = WINDOW(_width) >>1 CALL LOCALTOGLOBAL(centerY) LONG IF SYSTEM(3) = 0'newer than a Mac plus gdHndl& =FN GETDEVICELIST'handle to 1st device in list DO t;8 = [gdHndl&]+_gdRect'get its rect LONG IF FN PTINRECT(centerY,t)'cntr of wnd in this monitor? gdHndl& = 0 XELSE gdHndl& = FN GETNEXTDEVICE(gdHndl&)'get next scrn END IF'end of not main scrn UNTIL gdHndl& = 0 END IF'end of not a max plus t = t + {_mBarHeight}'allow for the menu bar FN pGinsetWnd(@t,_docZoom,@t)'inset wnd as per window kind END IF SETZOOM gWhichWindow,@t END FN '_______________________________________________________________________________ LOCAL FN pGupdate'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— theCount = FN pGcountObj(WINDOW(_outputWClass)) LONG IF theCount FOR loop = 1 TO theCount FN pGgetObj(WINDOW(_outputWClass),loop) LONG IF gObjKind = _graphicObj FN pGuseObjColor'set to this color LONG IF gObjZType'not a line LONG IF gObjFillPat > -1'shape is filled PEN 1,1,1,_patCopy,gObjFillPat'set fill pat SELECT gObjZType CASE 4:CALL PAINTRECT(gObjT)'filled box CASE 5:CALL PAINTROUNDRECT(gObjT,16,16)'filled rnd rect CASE 6:CALL PAINTOVAL(gObjT)'filled oval END SELECT END IF PEN gObjRef,gObjRef,1,_patCopy,gObjLinePat SELECT gObjZType CASE 1,4:CALL FRAMERECT(gObjT)'box CASE 2,5:CALL FRAMEROUNDRECT(gObjT,16,16)'rnd rect CASE 3,6:CALL FRAMEOVAL(gObjT)'oval END SELECT XELSE'it's a line PEN gObjRef,gObjRef,1,_patCopy,gObjLinePat CALL MOVETO(gObjL,gObjT) CALL LINETO(gObjR,gObjB) END IF XELSE LONG IF gObjKind = _buttonObj AND gObjZType = 0 gSubAction = _otherUserUpdate'set flag to draw obj gWhichObjElem = loop'record this element num FN pGcalcWndGlobals GLOBALS GOSUB "PG:Any Other"' manually for GOSUB END IF END IF NEXT FN pGblackAndWhite END IF END FN '_______________________________________________________________________________ LOCAL FN pGgetWTitle(theWindow)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— gWindowTitle$ = "" LONG IF theWindow GET WINDOW theWindow ,wPtr& IF wPtr& THEN CALL GETWTITLE(wPtr&,gWindowTitle$) END IF END FN '_______________________________________________________________________________ LOCAL FN pGcloseWindow(wndRefNum)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— :'see if window exists LONG IF WINDOW(-wndRefNum) = 0 OR wndRefNum<1 OR wndRefNum>64 FN pGshowErr(10)'show the error XELSE WINDOW wndRefNum gWhichClass = WINDOW(_outputWClass) gActWindow = wndRefNum theCount = FN pGcountObj(gWhichClass) LONG IF theCount FOR loop = 1 TO theCount FN pGgetObj(gWhichClass,loop) LONG IF gObjKind = _buttonObj LONG IF gObjZType = 0 gSubAction = _otherUserDispose'set flag to dispose obj gWhichObjElem = loop GLOBALS GOSUB "PG:Any Other" END IF END IF NEXT END IF DIM pGwT,pGwL,pGwB,pGwR,pGwKind,pGwAttrs,pGwMinX,pGwMinY DIM pGwMaxX,pGwMaxY,pGZmT,pGZmL,pGZmB,pGZmR DIM pGwHpg,pGwHMax,pGwVpg,pGwVMax,pGwRefCon& wTitle$ = FN pGgetWnd$(gWhichClass,@pGwT) LONG IF pGwAttrs AND _openPrevMask'€€ Open Previous €€€€€€€€€€€€ pGwT;8 = WINDOW(_wndPointer)+_portRect'get local rect CALL LOCALTOGLOBAL(pGwT)'convert top/left to global CALL LOCALTOGLOBAL(pGwB)'convert bot/right to global FN pGputWnd(gWhichClass,@pGwT)'save these coords END IF' WINDOW CLOSE wndRefNum'close the window END IF FN pGcalcWndGlobals FN pGgetWTitle(gActWindow) END FN '_______________________________________________________________________________ LOCAL FN pGclose(wndRefNum)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— gDialogValue = wndRefNum GLOBALS GOSUB "PG:WCls" END FN '_______________________________________________________________________________ LOCAL FN pGcloseAll'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— OK2Close = _zTrue WHILE (WINDOW(_activeWnd)<>0) AND (gAction<>0) gDialogValue = WINDOW(_activeWnd) GLOBALS GOSUB"PG:WCls" OK2Close = (gAction <> 0) WEND END FN = OK2Close '_______________________________________________________________________________ LOCAL FN pGbuild(wndRefNum)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM pGwT,pGwL,pGwB,pGwR,pGwKind,pGwAttrs,pGwMinX,pGwMinY DIM pGwMaxX,pGwMaxY,pGZmT,pGZmL,pGZmB,pGZmR DIM pGwHpg,pGwHMax,pGwVpg,pGwVMax,pGwRefCon& ' DIM t,l,b,r'scratch rect DIM secndT,secndL,secndB,secndR'rect of secondary monitor gWhichClass = ABS(wndRefNum) LONG IF wndRefNum < 0 FOR loop = 1 TO 64 LONG IF WINDOW(-loop) = 0 LONG IF FN GETRESOURCE(_"pG3w",loop) = 0 wndRefNum = loop loop = 64 END IF END IF NEXT END IF LONG IF WINDOW(-wndRefNum)'already opened? WINDOW wndRefNum'bring it forward XELSE LONG IF FN GETRESOURCE(_"pG3w",gWhichClass) = 0 FN pGshowErr(9):GOTO"PG:Build Complete" END IF wTitle$ = FN pGgetWnd$(gWhichClass,@pGwT)'get resource LONG IF wTitle$<>"ERROR"'got the resource? LONG IF pGwAttrs AND _openFullMask'€€ Full/Main €€€€€€€€€€€€€€€€ pGwT;8 = @gScrnT'copy main screen rect FN pGinsetWnd(@pGwT,pGwKind,@pGwT)'adjust for title & borders END IF LONG IF pGwAttrs AND _openFull2Mask'€€ Full/Secondary €€€€€€€€€€€ LONG IF SYSTEM(3)'mac plus (no device drvr) pGwT;8 = @gScrnT'just copy the main scrn XELSE'otherwise gdHndl& =FN GETDEVICELIST'handle to 1st device in list pGwT;8 = [gdHndl&]+_gdRect'get its rect LONG IF {[gdHndl&]+_gdflags} AND _mainScreen%'keep going-it's main scrn gdHndl& = FN GETNEXTDEVICE(gdHndl&)'get second scrn LONG IF gdHndl&'2nd device exists? pGwT;8 = [gdHndl&]+_gdRect'copy it's rect XELSE'otherwise pGwT;8 = @gScrnT'copy main screen rect END IF'end of valid device hndl END IF'end of not main scrn END IF'end of not a max plus FN pGinsetWnd(@pGwT,pGwKind,@pGwT)'inset wnd as per window kind END IF'done LONG IF pGwAttrs AND _openBigMask'€€ Full/Largest €€€€€€€€€€€€€ LONG IF SYSTEM(3)'mac plus (no device drvr) pGwT;8 = @gScrnT'just copy the main scrn XELSE'otherwise pGwB = pGwT'any rect is larger than this gdHndl& = FN GETDEVICELIST'handle to 1st device in list DO'we'll run thru all devices LONG IF gdHndl&'good handle t;8 = [gdHndl&]+_gdRect'grab it's rect LONG IF ((b-t)*(r-l)) > ((pGwB-pGwT)*(pGwR-pGwL)) pGwT;8 = @t'larger area - use this one END IF' END IF' gdHndl& = FN GETNEXTDEVICE(gdHndl&)'next graphic device in list UNTIL gdHndl& = 0'till there are no more END IF'dun FN pGinsetWnd(@pGwT,pGwKind,@pGwT)'allow for title/borders END IF' LONG IF pGwAttrs AND _openCntrMask'€€ Center €€€€€€€€€€€€€€€€€€€ CALL OFFSETRECT(pGwT,-pGwL,-pGwT)'Basic centers if zero offset END IF' LONG IF pGwAttrs AND _openPrevMask'€€ Previous €€€€€€€€€€€€€€€€€ LONG IF FN PTINRGN(pGwB,[_grayrgn])=_false'bot/right isn't visible? wd = gScrnR-gScrnL'width of main screen ht = gScrnB-gScrnT'height of main LONG IF pGwR - pGwL > wd'width won't fit? pGwR = gScrnR:pGwL = gScrnL'copy main screen rect t;8 = @pGwT'store old for restore of ht FN pGinsetWnd(@pGwT,pGwKind,@pGwT)'adjust for title & borders pGwT = t:pGwB = b'repair height to orig END IF'should be in position now LONG IF pGwB - pGwT > ht'height won't fit? pGwT = gScrnT:pGwB = gScrnB'copy main screen rect t;8 = @pGwT'store old for restore of wd FN pGinsetWnd(@pGwT,pGwKind,@pGwT)'adjust for title & borders pGwR = r:pGwL = l'repair width END IF'should be in position now IF pGwB > gScrnB THEN CALL OFFSETRECT(pGwT,0,gScrnB-pGwB) IF pGwR > gScrnR THEN CALL OFFSETRECT(pGwT,gScrnR-pGwR,0) END IF'end of bot/right invisible END IF LONG IF gWhichClass <> wndRefNum'€€ Build Class €€€€€€€€€€€€€€ LONG IF pGwT OR pGwL'not centered chkWnd = 64'checking all windows WHILE chkWnd'until we hit zero GET WINDOW chkWnd,wPtr&'get this window LONG IF wPtr&'got a pointer? CALL SETPORT(wPtr&)'make it the current port ` MOVE.L #0,^t ;set point to 0,0 CALL LOCALTOGLOBAL(t)'switch to global coords LONG IF pGwT = t OR pGwL = l'matches slot we want? CALL OFFSETRECT(pGwT,4,4)'offset to next position chkWnd = 64'restart at top of wnd list END IF'end of matched point END IF'end of valid wnd ptr DEC(chkWnd)'next (lower) window WEND'until checked wnd = 0 END IF END IF'€€ Invisible €€€€€€€€€€€€€€€€ LONG IF (pGwAttrs AND _openInvisMask) OR (pGwAttrs AND _openBehindMask) wndRefNum = -wndRefNum'open behind others END IF LONG IF SYSTEM(8) < 700'pre System 7.0 IF pGwKind = 6 THEN pGwKind = 2'don't allow window type 6 IF pGwKind = -6 THEN pGwKind = -2'not even modals END IF WINDOW wndRefNum,wTitle$,@pGwT,pGwKind,gWhichClass CALL SETRECT(t,-9999,-9999,9999,9999) CALL CLIPRECT(t)'€€ 03/30/93 €€ FN pGblackAndWhite:CALL ERASERECT(t) LONG IF pGwHMax'window scroll bars SCROLL BUTTON 8000,1,1,pGwHMax,pGwHpg,,2'horiz scroll bar END IF ref = 0 LONG IF pGwVMax LONG IF pGwAttrs AND 128 FN pGdrawControls'draw the field in advance SCROLL BUTTON -8001,0,0,0,0,,1'vert scroll bar ref = -8001'use negative to hook in scroll CALL VALIDRECT(t) FN pGfixEditor XELSE ref = 8001'otherwise-standard V scroll SCROLL BUTTON ref,1,1,pGwVMax,pGwVpg,,1'vert scroll bar END IF END IF IF ref <> -8001 THEN FN pGdrawControls'ctrls for pg Wnds LONG IF pGwAttrs AND _openInvisMask'was in back LONG IF pGwRefCon& <> _"NVIS"'user didn't specify invisible WINDOW -wndRefNum'bring to front END IF END IF' LONG IF pGwAttrs AND _openBehindMask'was in back LONG IF pGwRefCon& <> _"NVIS"'user didn't specify invisible WINDOW OUTPUT wndRefNum'activate w/o bringing fwd END IF END IF LONG IF pGwAttrs AND 128'splash bit set LONG IF pGwVMax = 0'not a Text Editor FN pGupdate'don't wait for update event ticks& = FN TICKCOUNT + 140:flag =_false'calc time out:clear flag DO'loop till button,key or ticks IF FN BUTTON OR LEN(INKEY$) THEN flag = _zTrue LONG IF FN TICKCOUNT>ticks&'sufficient number of ticks? LONG IF gWhichClass = wndRefNum'window num was not negative? flag = _zTrue'time expired - exit END IF' END IF' UNTIL flag' % EVENT,0:FLUSHEVENTS'clear the event from the que WINDOW CLOSE ABS(wndRefNum)'close this feller END IF END IF END IF END IF "PG:Build Complete" FN pGcalcWndGlobals LONG IF gOutWindow CALL GETWTITLE(WINDOW(_wndPointer),gWindowTitle$) XELSE gWindowTitle$ = ""'clear related globals END IF END FN '_______________________________________________________________________________ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ RUNTIME FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '——————————————————————————————————————————————————————————————————————————————— '_______________________________________________________________________________ LOCAL FN pGmouse'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— clickedObj = FN pGpointInObj LONG IF clickedObj FN pGgetObj(gWhichClass,clickedObj) LONG IF gObjKind = _buttonObj LONG IF gObjZType = 0 gSubAction = _otherUserClick'tell user item was clicked gWhichObjElem = clickedObj GLOBALS GOSUB "PG:Any Other" END IF END IF END IF END FN '_______________________________________________________________________________ LOCAL FN pGcursor'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— LONG IF WINDOW(_outputWnd) = DIALOG(_cursEvent)'correct window? SELECT gWhichButton'same as gWhichField CASE <0:'show IBeam cursor TEHndl& = TEHANDLE(ABS(gWhichButton))'if T=B then it's a pict LONG IF {[TEHndl&]+_TEViewRect} = {[TEHndl&]+_TEViewRect.bottom} CURSOR _pictCursor'over a pict field XELSE CURSOR _iBeamCursor'over a text field END IF CASE >0:CURSOR _buttonCursor'use hand cursor CASE ELSE:CURSOR _arrowCursor END SELECT XELSE'not in active window CURSOR _arrowCursor'back to arrow END IF' END FN '_______________________________________________________________________________ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ MENU FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '——————————————————————————————————————————————————————————————————————————————— '_______________________________________________________________________________ LOCAL FN pGfindMenu(theTitle$)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— theMenu = 0 mCount = FN COUNTRESOURCES(_"MENU") FOR thisMenu = 1 TO mCount mHndl& = FN GETINDRESOURCE(_"MENU",thisMenu) LONG IF mHndl& LONG IF FN HOMERESFILE(mHndl&) = SYSTEM(_aplRes) test$ = PSTR$([mHndl&] + _menuData) LONG IF test$ = theTitle$ theMenu = {[mHndl&]} thisMenu = mCount END IF END IF END IF NEXT END FN = theMenu '_______________________________________________________________________________ LOCAL FN pGfield(xLook,yLook)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— DIM srcT,srcL,srcB,srcR,destT;8 found = _false srcT;8 = [TEHANDLE(gWhichField)]+_TEViewRect objCount = FN pGcountObj(gWhichClass) DO CALL OFFSETRECT(srcT,xLook,yLook) x = FN SECTRECT(srcT,#WINDOW(_wndPointer)+_portRect,destT) LONG IF FN EQUALRECT(srcT,destT) = _false found = _zTrue XELSE FOR loop = 1 TO objCount FN pGgetObj(gWhichClass,loop) LONG IF gObjKind = _styleObj LONG IF gObjRef <> gWhichField LONG IF ((gObjZType-1) AND &X1100)=0'not a static or gray field LONG IF FN SECTRECT(srcT,gObjT,destT) found = _zTrue EDIT FIELD ABS(gObjRef) END IF END IF END IF END IF NEXT END IF UNTIL found END FN '_______________________________________________________________________________ LOCAL FN pGtab(shiftDown)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— objCount = FN pGcountObj(gWhichClass)'object count for this wnd LONG IF objCount'non zero? dfltFld = 0'default:nothing found grabNext = _false'don't record yet LONG IF shiftDown'shift tab works in reverse finish = 1:start = objCount'so run the loop backwards theStep =-1'and step backwards XELSE'otherwise start = 1:finish = objCount'run loop forward thru list theStep = 1'step is normal END IF FOR loop = start TO finish STEP theStep'loop thru all objs FN pGgetObj(gWhichClass,loop)'get the next one LONG IF gObjKind = _styleObj'a styled text field? LONG IF ((gObjZType-1) AND &X1100)=0'not a static or gray field LONG IF dfltFld = 0'default set yet? dfltFld = gObjRef'no first item = wrap around END IF LONG IF grabNext'flag set to grab next? dfltFld = gObjRef'yep-this is the field loop = finish'shortcut the loop END IF LONG IF gObjRef = gWhichField'this is the current field? grabNext = _zTrue'yep-grab next one encountered END IF END IF'end of non-static field END IF'end of styled text field NEXT loop LONG IF dfltFld'if we got one… EDIT FIELD dfltFld' set it LONG IF WINDOW(_selStart) = WINDOW(_EFTextLen) LONG IF WINDOW(_EFnum) < 8000 SETSELECT 0,WINDOW(_EFTextLen) END IF END IF END IF END IF END FN '_______________________________________________________________________________ LOCAL FN pGgetItemName$(menuID,itemID)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— mHndl& = FN GETMHANDLE(menuID) LONG IF mHndl& CALL GETITEM(mHndl&,itemID,theName$) XELSE theName$ = "" END IF END FN = theName$ '_______________________________________________________________________________ LOCAL FN pGcheckName(theMenu,theName$)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— mHndl& = FN GETMHANDLE(theMenu)'handle to this menu LONG IF mHndl&'valid handle? itemCount = FN COUNTMITEMS(mHndl&)'number of items in menu FOR loop = 1 TO itemCount'loop thru items CALL GETITEM(mHndl&,loop,t$)'get name of item LONG IF t$ = theName$'match? DEF CHECKONEITEM(theMenu,loop) loop = itemCount'skip the rest of the loop END IF NEXT END IF END FN '_______________________________________________________________________________ CLEAR LOCAL'must clear pBlock LOCAL FN pGopenFile'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— gFileName$ = FILES$(1,gOpenType$,,gFileVol)'standard files dialog LONG IF PEEK(@gFileName$)'name <>""? gSubAction = _mainOpen'set up message pBlk& = @paramBlk$'param Block to get file info & pBlk& + _ioFDirIndex,0'clear to indicate op & pBlk& + _ioNamePtr,@gFileName$'set up pointer to file name % pBlk& + _ioVRefNum,gFileVol'set up vol number OSErr = FN GETFILEINFO(pBlk&)'get finder info on this file gFileType& = [pBlk& + _ioBuffer]'get file type fdFlags = {pBlk& + _ioBuffer_fdflags}'get finder flags gIsStationery = ((fdFlags AND 2048)<>0)'check stationery bit GLOBALS GOSUB "PG:Any Main"'send it to program END IF END FN '_______________________________________________________________________________ LOCAL FN pGsaveAs'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— LONG IF LEN(gSaveName$)'file name exists? t$ = gSaveName$'use it XELSE'otherwise t$ = "Untitled Document"'use a default name END IF t$ = FILES$(0,"Save document as…",t$,vol)'standard files LONG IF LEN(t$)'SF wasn't canceled? gSaveName$ = t$'file name into global gSaveVol = vol'vol ref into global boolean = _zTrue'success-set flag XELSE'save was canceled boolean = _false'failure-clear flag END IF END FN = boolean '_______________________________________________________________________________ LOCAL FN pGautoMenu(menuID,itemID)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— mHndl& = FN GETMHANDLE(menuID) LONG IF mHndl& theTitle$ = PSTR$([mHndl&] + _menuData) CALL GETITEM(mHndl&,itemID,theItem$) LONG IF theTitle$ = STR#(_baseID - 2,1)'== FILE MENU == t$ = STR#(_baseID - 2,2)'special allowances for open l = LEN(t$)'addn'l chars added by LONG IF l IF LEFT$(theItem$,l) = t$ THEN theItem$ = t$' Boomerang END IF SELECT theItem$ CASE STR#(_baseID - 2,2)'"Open" item FN pGopenFile CASE STR#(_baseID - 2,4)'"Page Setup…" item DEF PAGE CASE STR#(_baseID - 2,5)'"Close" item LONG IF WINDOW(_activeWnd) gDialogValue = WINDOW(_activeWnd) GLOBALS GOSUB"PG:WCls" END IF CASE STR#(_baseID - 2,6)'"Quit" item GLOBALS GOSUB"PG:Break" CASE STR#(_baseID - 2,3)'"Save" item boolean = _zTrue LONG IF LEN(gSaveName$) = 0 OR gSaveVol = 0 boolean = FN pGsaveAs END IF LONG IF boolean gSubAction = _mainSave gDirty = _false GLOBALS GOSUB"PG:Any Main" END IF CASE STR#(_baseID - 2,7)'"Save As…" item boolean = FN pGsaveAs LONG IF boolean gSubAction = _mainSave gDirty = _false GLOBALS GOSUB"PG:Any Main" END IF END SELECT END IF END IF END FN '_______________________________________________________________________________ LOCAL FN pGfixMenus'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— IF FN BUTTON THEN CURSOR _arrowCursor t$ = STR#(_baseID - 2,1)'get name of File menu LONG IF LEN(t$) fileMenu = FN pGfindMenu(t$) LONG IF fileMenu mHndl& = FN GETMHANDLE(fileMenu) LONG IF mHndl& saveName$ = STR#(_baseID - 2,3)'name of Save item saveAsName$ = STR#(_baseID - 2,7)'name of Save As… item printItem$ = STR#(_baseID - 2,8)'name of print item itemCount = FN COUNTMITEMS(mHndl&) FOR loop = 1 TO itemCount CALL GETITEM(mHndl&,loop,t$) SELECT t$ CASE saveName$ MENU fileMenu,loop,ABS(gDirty<>0)'enable if dirty IF WINDOW(_activeWnd) = 0 THEN MENU fileMenu,loop,0 CASE saveAsName$ MENU fileMenu,loop,ABS(LEN(gSaveName$)>0)'enable if file open IF WINDOW(_activeWnd) = 0 THEN MENU fileMenu,loop,0 CASE printName$ MENU fileMenu,loop,ABS(WINDOW(_activeWnd)<>0) END SELECT NEXT END IF END IF END IF END FN '_______________________________________________________________________________ LOCAL FN pGopenDoc'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— fileIndex = {[gFileList&]+2} % [gFileList&]+2,fileIndex - 1 offSet = 4 LONG IF fileIndex > 1 FOR loop = 1 TO fileIndex - 1 offSet = offSet + 8 lgth = PEEK([gFileList&]+offSet) + 1 lgth = (lgth + 1) AND &FE offSet=offSet+lgth NEXT END IF gSubAction = {[gFileList&]} + 2'_mainOpen or _mainPrint gFileVol = {[gFileList&]+offSet} gFileType& = [[gFileList&]+offSet+2] gFileName$ = PSTR$([gFileList&]+offSet+8) IF fileIndex = 1 THEN DEF DISPOSEH(gFileList&) GLOBALS GOSUB "PG:Any Main" END FN '_______________________________________________________________________________ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ RUNTIME INIT €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '——————————————————————————————————————————————————————————————————————————————— '_______________________________________________________________________________ LOCAL FN pGinitRuntime'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '————————————————————————————————————————————————————————————————————————————— gEventPtr& = EVENT'event rec never moves IF SYSTEM(8) > 599 THEN & EVENT-8,1'WNE 60 times/sec(Sys.6.0 & up) gResRef = SYSTEM(4)'current resource reference gScrnR = SYSTEM(6)'screen width gScrnB = SYSTEM(7)'screen height gScrnT = {_mBarHeight}'allow for menu bar gScreenDepth = SYSTEM(11)'max colors CALL SETRECT(gBigT,-9999,-9999,9999,9999)'generic big rect curRes = FN CURRESFILE'record curres file CALL USERESFILE(gResRef)'switch to app's file theCount = FN COUNT1RESOURCES(_"MENU")'how many menus? WHILE theCount'more to go? resHndl& = FN GET1INDRESOURCE(_"MENU",theCount)'get next menu LONG IF resHndl&'valid handle? menuID = {[resHndl&]}'get its ID LONG IF menuID > 74 AND menuID < 100'74> Sub menus <100 MENU menuID,-2,1'insert it END IF END IF DEC(theCount)'decrement index WEND CALL USERESFILE(curRes) LONG IF SYSTEM(8) > 699'System 7.0 or later LONG IF FN GESTALT(_gestaltAppleEventsAttr) AND SYSERROR = 0 OSErr = FN AEINSTALLEVENTHANDLER(_typeAppleEvent,_kAEOpenApplication,LINE"PG:AE Open App",0,_false) OSErr = FN AEINSTALLEVENTHANDLER(_typeAppleEvent,_kAEOpenDocuments ,LINE"PG:AE Open Doc",0,_false) OSErr = FN AEINSTALLEVENTHANDLER(_typeAppleEvent,_kAEPrintDocuments ,LINE"PG:AE Print Doc",0,_false) OSErr = FN AEINSTALLEVENTHANDLER(_typeAppleEvent,_kAEQuitApplication,LINE"PG:AE Quit App",0,_false) END IF END IF LONG IF [_appParmHandle] LONG IF {[[_appParmHandle]]+2} LONG IF SYSTEM(_aplFlag) gFileList& = FN HANDTOHAND([_appParmHandle]) END IF END IF END IF DIM pGwT,pGwL,pGwB,pGwR,pGwKind,pGwAttrs,pGwMinX,pGwMinY DIM pGwMaxX,pGwMaxY,pGZmT,pGZmL,pGZmB,pGZmR DIM pGwHpg,pGwHMax,pGwVpg,pGwVMax,pGwRefCon& theCount = FN COUNTRESOURCES(_"pG3w")'look for splash windows FOR loop = 1 TO theCount resHndl& = FN GETINDRESOURCE(_"pG3w",loop) LONG IF resHndl& BLOCKMOVE [resHndl&],@pGwT,FN GETHANDLESIZE(resHndl&) LONG IF pGwVMax = 0 LONG IF pGwAttrs AND 128 CALL GETRESINFO(resHndl&,ID,tp&,t$) FN pGbuild(ID) loop = theCount END IF END IF END IF NEXT GLBLask& = @FN pGask$ :GLBLautoMenu& = @FN pGautoMenu GLBLBlkNWhite& = @FN pGblackAndWhite :GLBLbtnAction& = @FN pGbtnAction GLBLbuild& = @FN pGbuild :GLBLcheckName& = @FN pGcheckName GLBLclose& = @FN pGclose :GLBLcloseAll& = @FN pGcloseAll GLBLcntrRes& = @FN pGcntrRes :GLBLcountObj& = @FN pGcountObj GLBLcursor& = @FN pGcursor :GLBLdrwCtrls& = @FN pGdrawControls GLBLfield& = @FN pGfield :GLBLfindMenu& = @FN pGfindMenu GLBLfixEditor& = @FN pGfixEditor :GLBLfixMenus& = @FN pGfixMenus GLBLframeBtn& = @FN pGframeBtn :GLBLgetGroup& = @FN pGgetGroup GLBLgetIName& = @FN pGgetItemName$ :GLBLgetObj& = @FN pGgetObj GLBLgetRef& = @FN pGgetRef :GLBLgetText& = @FN pGgetText$ GLBLgetWnd& = @FN pGgetWnd$ :GLBLgetWTitle& = @FN pGgetWTitle GLBLinitRntm& = @FN pGinitRuntime :GLBLinsetWnd& = @FN pGinsetWnd GLBLmouse& = @FN pGmouse :GLBLopenDoc& = @FN pGopenDoc GLBLopenFile& = @FN pGopenFile :GLBLptInObj& = @FN pGpointInObj GLBLputObj& = @FN pGputObj :GLBLputWnd& = @FN pGputWnd GLBLrepRes& = @FN pGreplaceRes :GLBLrepXRes& = @FN pGreplaceXRes GLBLsaveAs& = @FN pGsaveAs :GLBLsetGroup& = @FN pGsetGroup GLBLsetGrow& = @FN pGsetGrow :GLBLsetZoom& = @FN pGsetZoom GLBLshowErr& = @FN pGshowErr :GLBLtab& = @FN pGtab GLBLupdate& = @FN pGupdate :GLBLuseObjClr& = @FN pGuseObjColor GLBLpntDpth& = @FN pGdepthOfPoint END FN '_______________________________________________________________________________ CLEAR LOCAL'must clear pBlk & noName$ LOCAL FN pGAEDocList'›fi› 01/15/92 ›fi› '————————————————————————————————————————————————————————————————————————————— DIM AEDesc&;0,descriptorType&,dataHandle& DIM fsSpec;0,fsVRefNum,fsParID&,63 fsName$ maxSize& = @maxSize& - @fsSpec LONG IF FN AEGETPARAMDESC(gEventPtr&,_keyDirectObject,_typeAEList,AEDesc&)= 0 LONG IF FN AECOUNTITEMS(AEDesc&,theCount&) = 0 FOR loop = 1 TO theCount& LONG IF FN AEGETNTHPTR(AEDesc&,loop,_typeFSS,keyWord&,rtnType&,@fsSpec,maxSize&,actualSize&) = 0 gFileName$ = fsName$'record name from FS rec pBlk& = @paramBlk$'chg WrkDirID to vRefNum % pBlk& + _ioVRefNum ,fsVRefNum'volume ref num & pBlk& + _ioWDDirID ,fsParID&'set par ID in pblock OSErr = FN OPENWD(pBlk&)'open this path gFileVol = {pBlk& + _ioVRefNum}'get volRef num & pBlk& + _ioFDirIndex,0'clear dir index to indicate op & pBlk& + _ioNamePtr,@fsName$'set up pointer to file name OSErr = FN GETFILEINFO(pBlk&)'get finder info on this file gFileType& = [pBlk& + _ioBuffer]'get file type fdFlags = {pBlk& + _ioBuffer_fdflags}'get finder flags gIsStationery = ((fdFlags AND 2048)<>0)'check stationery bit GLOBALS GOSUB "PG:Any Main" END IF DEF BLOCKFILL(pBlk&,250,0)' ∑∑ 8/13/93 ∑∑ NEXT END IF OSErr = FN AEDISPOSEDESC(AEDesc&) END IF END FN '_______________________________________________________________________________ "PG:AE Open App"'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '——————————————————————————————————————————————————————————————————————————————— ENTERPROC(gEventPtr&,gEventPtr&,gWhichRefCon&) :'do nothing gMessage1 = 0 EXITPROC = gMessage1 RETURN '_______________________________________________________________________________ "PG:AE Quit App"'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '——————————————————————————————————————————————————————————————————————————————— ENTERPROC(gEventPtr&,gEventPtr&,gWhichRefCon&) GLOBALS GOSUB "PG:Break" gMessage1 = 0 EXITPROC = gMessage1 RETURN '_______________________________________________________________________________ "PG:AE Print Doc"'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '——————————————————————————————————————————————————————————————————————————————— ENTERPROC(gEventPtr&,gEventPtr&,gWhichRefCon&) gSubAction = _mainPrint FN pGAEDocList gMessage1 = 0 EXITPROC = gMessage1 RETURN '_______________________________________________________________________________ "PG:AE Open Doc"'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑ '——————————————————————————————————————————————————————————————————————————————— ENTERPROC(gEventPtr&,gEventPtr&,gWhichRefCon&) gSubAction = _mainOpen FN pGAEDocList gMessage1 = 0 EXITPROC = gMessage1 RETURN '_______________________________________________________________________________ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ RUNTIME PACKAGE €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '——————————————————————————————————————————————————————————————————————————————— "PG:Start" FN pGinitRuntime'handle my startup ON BREAK GOSUB "PG:Chk Break"'go here for command-period ON DIALOG GOSUB "PG:Dialog"'use this routine for dialog ON EDIT GOSUB "PG:TEKey"'filter keys for edit flds ON EVENT GOSUB "PG:Event"'pre-event filter ON MENU GOSUB "PG:Menu"'menu handlers ON MOUSE GOSUB "PG:Mouse"'mouse handler ON TIMER(-10) GOSUB "PG:Timer"'ZTimer (30 ticks=1/2 second) ON STOP GOSUB "PG:Stop" '------------------------------------------------------------------------------- gSubAction =_mainStart'let user init GOSUB "PG:Any Main" '------------------------------------------------------------------------------- DO MENU ON : DIALOG ON : BREAK ON : MOUSE ON : TIMER ON : EVENT ON MENU OFF : DIALOG OFF : BREAK OFF : MOUSE OFF : TIMER OFF : EVENT OFF IF gKissOfDeath THEN GOSUB"PG:Break" UNTIL 0 '------------------------------------------------------------------------------- "PG:Menu" '------------------------------------------------------------------------------- gAction = _MenuAction'action constant gWhichMenu = MENU(_menuID)'selected menu gWhichItem = MENU(_itemID)'selected item gItemName$ = FN pGgetItemName$(gWhichMenu,gWhichItem)'get name of this item GOSUB "PG:Send Event"'send event to user MENU'unhilite the menu IF gAction THEN FN pGautoMenu(gWhichMenu,gWhichItem) RETURN'done '------------------------------------------------------------------------------- "PG:Dialog" '------------------------------------------------------------------------------- gWhichDialog = DIALOG(0)'dialog action gDialogValue = DIALOG(gWhichDialog)'dialog reference ON gWhichDialog GOTO "PG:Btn" ,"PG:EAct","PG:WClk","PG:WCls" ,"PG:WUpd" ON gWhichDialog - 5 GOTO "PG:ERet","PG:ETab","PG:NOP" ,"PG:NOP" ,"PG:EStb" ON gWhichDialog - 10 GOTO "PG:EClr","PG:ELft","PG:ERt" ,"PG:EUp" ,"PG:EDn" ON gWhichDialog - 15 GOTO "PG:Key" ,"PG:Dsk" ,"PG:WAct","PG:MFevt","PG:Gcrs" ON gWhichDialog - 20 GOTO "PG:Crsr","PG:Abt" ,"PG:Usr" RETURN '=============================================================================== "PG:Btn"'(1) Button clicked gAction = _buttonAction'action constant gWhichButton = gDialogValue'clicked button gWhichClass = WINDOW(_outputWClass) FN pGbtnAction(gWhichButton) gWhichObjElem= FN pGgetRef(gWhichClass,gWhichButton)'get btn's obj record gButtonValue = BUTTON(gWhichButton)'current btn value gControlHndl&= BUTTON&(gWhichButton)'get control's handle LONG IF (FN GETCREFCON(gControlHndl&)>>29) = 4'ZBasic scroll bar? gControlTitle$ = STR#(_baseID-5,4)'send "Scroll Button" as title XELSE'not a scroll bar? CALL GETCTITLE(gControlHndl&,gControlTitle$)'send control's title END IF GOTO "PG:Send Event" RETURN '=============================================================================== "PG:WClk"'(5) Inactive Window Clicked gSubAction = _windowClicked'sub action:click in inactive gWhichWindow = gDialogValue'window clicked GOSUB "PG:Any Window"'send wnd msg(sets action _con) LONG IF gAction'not handled by user? IF gWhichWindow THEN WINDOW gWhichWindow'I'll do the switch END IF RETURN '------------------------------------------------------------------------------- "PG:WCls"'(4) Click in close box gSubAction = _windowClose'subaction constant gWhichWindow = gDialogValue GOSUB "PG:Any Window"'send wnd msg(sets action _con) LONG IF gAction'not handled by user? FN pGcloseWindow(gWhichWindow)'I'll close it END IF RETURN '------------------------------------------------------------------------------- "PG:WAct"'(18) activate/deactivate gWhichWindow = ABS(gDialogValue) LONG IF gDialogValue > 0 gSubAction =_windowActivate' positive = activate XELSE' negative = deactivate gSubAction =_windowDeactivate END IF GOTO "PG:Any Window"'send wnd msg(sets action _con) RETURN '------------------------------------------------------------------------------- "PG:WUpd"'(5) update gWhichWindow = gDialogValue gSubAction = _windowUpdate gOutputWas = WINDOW(_outputWnd) WINDOW OUTPUT gWhichWindow GOSUB "PG:Any Window" IF gAction THEN FN pGupdate IF gOutputWas THEN WINDOW OUTPUT gOutputWas RETURN '------------------------------------------------------------------------------- "PG:NOP"'No Operation RETURN '=============================================================================== "PG:EAct"'(2) Edit/Pict field Clicked gSubAction = _fieldActivate gFieldWas = WINDOW(_lastEFnum) GOTO "PG:Any Field" RETURN '------------------------------------------------------------------------------- "PG:ERet"'(6) Return key in field gSubAction = _fieldReturn GOTO "PG:Any Field" RETURN '------------------------------------------------------------------------------- "PG:ETab"'(7) Tab Key pressed gSubAction = _fieldTab GOSUB "PG:Any Field" IF gAction THEN FN pGtab(_false) RETURN '------------------------------------------------------------------------------- "PG:EStb"'(10) shift tab pressed gSubAction = _fieldShiftTab GOSUB "PG:Any Field" IF gAction THEN FN pGtab(_zTrue) RETURN '------------------------------------------------------------------------------- "PG:EClr"'(11) clear key pressed gSubAction = _fieldClear GOSUB "PG:Any Field" IF gAction THEN EDIT FIELD gObjRef,"" RETURN '------------------------------------------------------------------------------- "PG:ELft"'(12) left arrow pressed gSubAction = _fieldLeft GOSUB "PG:Any Field" IF gAction THEN FN pGfield(-10,0) RETURN '------------------------------------------------------------------------------- "PG:ERt"'(13) right arrow pressed gSubAction = _fieldRight GOSUB "PG:Any Field" IF gAction THEN FN pGfield(10,0) RETURN '------------------------------------------------------------------------------- "PG:EUp"'(14) up arrow pressed gSubAction = _fieldUp GOSUB "PG:Any Field" IF gAction THEN FN pGfield(0,-10) RETURN '------------------------------------------------------------------------------- "PG:EDn"'(15) down arrow pressed gSubAction = _fieldDown GOSUB "PG:Any Field" IF gAction THEN FN pGfield(0,10) RETURN '------------------------------------------------------------------------------- "PG:Any Field"'branch sets action constant gAction = _fieldAction gWhichField = gDialogValue gWhichObjElem = FN pGgetRef(WINDOW(_outputWClass),gWhichField)'get field's obj record FN pGgetObj(WINDOW(_outputWClass),gWhichObjElem) GOTO "PG:Send Event" RETURN '=============================================================================== "PG:Key"'(16) Key Presed Not in Field gKey$ = CHR$(gDialogValue) gSubAction = _otherKeyPressed GOTO "PG:Any Other" RETURN '------------------------------------------------------------------------------- "PG:Dsk"'(17) Disk Inserted gSubAction = _otherDisk GOSUB "PG:Any Other" IF gAction THEN FN pGopenFile RETURN '------------------------------------------------------------------------------- "PG:MFevt"'(19) MultiFinder Event SELECT gDialogValue CASE _MFResume'resume gSubAction = _otherSwitch gInBackground = _false FLUSHEVENTS CASE _MFSuspend'suspend gSubAction = _otherSwitch gInBackground = _zTrue CASE _MFClipboard'convert scrap gSubAction = _otherScrap gInBackground = _false CASE _MFMouse'mouse moved from MF region gSubAction = _otherCursor END SELECT GOTO "PG:Any Other" RETURN '------------------------------------------------------------------------------- "PG:Gcrs"'(20) New Global Mouse Position gSubAction = _otherCursor GOSUB "PG:Any Other"'send to user LONG IF gAction'not handled? CURSOR _arrowCursor'back to arrow END IF RETURN '------------------------------------------------------------------------------- "PG:Crsr"'(21) New Cursor Pos in Window gWhichButton = gDialogValue gSubAction = _otherCursor GOSUB "PG:Any Other"'send to user LONG IF gAction'not handled? FN pGcursor END IF RETURN '------------------------------------------------------------------------------- "PG:Abt"'(22) About to ??? SELECT CASE gDialogValue CASE _premenuclick'mouse in bar or cmnd key FN pGfixMenus gSubAction = _otherBeforeMenu GOSUB "PG:Any Other"'send to user CASE _preWndGrow'mouse in grow box gSubAction = _WindowWillGrow gWhichWindow = WINDOW(_activeWnd) GOSUB "PG:Any Window" LONG IF gAction FN pGsetGrow END IF CASE _wndMoved'already did a drag gSubAction = _windowMoved gWhichWindow = WINDOW(_activeWnd) GOSUB "PG:Any Window" CASE _wndSized'after grow gWhichWindow = WINDOW(_activeWnd) gSubAction = _windowSized GOSUB "PG:Any Window" LONG IF gAction FN pGfixEditor END IF CASE 5'field about to change gSubAction = _fieldChanging gDialogValue = WINDOW(_EFnum) GOSUB "PG:Any Field" CASE 6'field clicked gSubAction = _fieldClicked gDialogValue = WINDOW(_EFnum) GOSUB "PG:Any Field" CASE _preWndZoomIn'about to zoom in gSubAction = _windowWillZoomIn gWhichWindow = WINDOW(_activeWnd) GOSUB "PG:Any Window" CASE _preWndZoomOut'about to zoom out gSubAction = _windowWillZoomOut gWhichWindow = WINDOW(_activeWnd) GOSUB "PG:Any Window" IF gAction THEN FN pGsetZoom CASE _wndDocWillMove'background window will move gSubAction = _windowDocWillMove gWhichWindow = WINDOW(_outputWnd) GOSUB "PG:Any Window" END SELECT RETURN '------------------------------------------------------------------------------- "PG:Usr"'(23) User Posted Event LONG IF gDialogValue < 0 FN pGshowErr(EVENT%)'field or other error RETURN XELSE gSubAction = _otherUser GOTO "PG:Any Other" END IF '=============================================================================== "PG:Chk Break" IF _ignoreCmndPeriod THEN RETURN'command period pressed "PG:Break"'called to exit gSubAction = _mainShutDown gKissOfDeath = _zTrue GOSUB "PG:Any Main"'ask user to shutdown LONG IF gAction'user didn't abort close LONG IF FN pGcloseAll'could we close all windows END'we're outta here END IF END IF gKissOfDeath = _false RETURN '=============================================================================== "PG:Stop" DEF DISPOSEH(gFileList&) RETURN '=============================================================================== "PG:Mouse" gAction = _mouseAction gClickStatus = MOUSE(0) gMouseX = MOUSE(1) gMouseY = MOUSE(2) gModifiers = EVENT% gWhen& = EVENT& gWhereY;4 = @gMouseY CALL LOCALTOGLOBAL(gWhereY) GOSUB "PG:Send Event" IF gAction THEN FN pGmouse RETURN '=============================================================================== "PG:Timer" gSubAction = _mainTimer GOTO "PG:Any Main" RETURN '=============================================================================== "PG:TEKey" gKey$ = TEKEY$ gSubAction = _fieldKeyPressed gDialogValue = WINDOW(_EFnum) gWhichField = gDialogValue GOSUB "PG:Any Field" LONG IF gAction LONG IF gKey$ = CHR$(127) gKey$ = CHR$(29) + CHR$(8) END IF TEKEY$ = gKey$ END IF RETURN '=============================================================================== "PG:Event" gAction = _otherAction gWhat;_evtBlkSize = EVENT LONG IF {EVENT} gSubAction = _otherFilterEvent XELSE LONG IF gFileList& FN pGopenDoc:RETURN XELSE gSubAction = _otherNullEvent END IF END IF GOSUB "PG:Main Program" LONG IF {EVENT}=_updatEvt LONG IF gAction > 0 gWhichClass = WINDOW(_outputWClass) FN pGblackAndWhite END IF END IF RETURN '_______________________________________________________________________________ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ MAIN €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '——————————————————————————————————————————————————————————————————————————————— "PG:Any Window" gAction = _windowAction FN pGgetWTitle(gWhichWindow)'get title of this window GOTO "PG:Send Event" RETURN '------------------------------------------------------------------------------- "PG:Any Main" gAction = _mainAction GOTO "PG:Send Event" RETURN '------------------------------------------------------------------------------- "PG:Any Other" gAction = _otherAction '------------------------------------------------------------------------------- "PG:Send Event" FN pGcalcWndGlobals '------------------------------------------------------------------------------- '******************************************************************************* "PG:Main Program" '*******************************************************************************